home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / ROUND / ROUND.PAS
Pascal/Delphi Source File  |  1993-08-03  |  3KB  |  120 lines
  1. {
  2. Unfortunately, Turbo Pascal does not do a very good job of rounding
  3. numbers when using the built-in REAL data type.  For instance:
  4.   WRITELN(87.75:8:1);
  5. returns:
  6.       87.7               Yikes!
  7. This program contains two routines to round REALs and demonstrates the 
  8. problem with the PASCAL str function (which also applies to WRITELN).
  9. The function HalfAdjust will round 5 or more up and 4 or less down.
  10. The function rounded will round 6 or more up and 4 or less down and 5
  11. will round to an even value (the most correct mathematically).
  12.  
  13. John Lucas [70441,2451]
  14. }
  15.  
  16. {$N-}
  17.  
  18. function HalfAdjust(r : real; width, decimals : integer) : string;
  19. { always round up on "5" }
  20. var
  21.   temp : string;
  22.   half : real;
  23. begin
  24.   case decimals of
  25.     0  : half := 0.5;
  26.     1  : half := 0.05;
  27.     2  : half := 0.005;
  28.     3  : half := 0.0005;
  29.     4  : half := 0.00005;
  30.     5  : half := 0.000005;
  31.     6  : half := 0.0000005;
  32.     7  : half := 0.00000005;
  33.     8  : half := 0.000000005;
  34.     9  : half := 0.0000000005;
  35.     10 : half := 0.00000000005;
  36.     11 : half := 0.000000000005;
  37.     else half := 0.0;
  38.   end;
  39.   if r<0 then
  40.     r := r-half
  41.   else
  42.     r := r+half;
  43.   str(r:0:11,temp);
  44.   if decimals=0 then
  45.     dec(temp[0],12)
  46.   else
  47.     dec(temp[0],11-decimals);
  48.   dec(width,length(temp));
  49.   if width>0 then begin
  50.     move(temp[1],temp[succ(width)],length(temp));
  51.     inc(temp[0],width);
  52.     fillchar(temp[1],width,' ')
  53.   end;
  54.   HalfAdjust := temp
  55. end; {HalfAdjust}
  56.  
  57. function rounded(r : real; width, decimals : integer) : string;
  58. { round on "5" to an even value } 
  59. var
  60.   temp : string;
  61.   point : integer;
  62.   i : integer;
  63. begin
  64.   str(r:0:11,temp);
  65.   insert('0',temp,1);
  66.   point := length(temp)-11;
  67.   delete(temp,point,1);
  68.   if temp[point+decimals]='5' then
  69.     if odd(ord(temp[point+decimals-1])) then
  70.       for i := pred(point) downto 1 do
  71.         if temp[i]='9' then
  72.           temp[i] := '0'
  73.         else
  74.           begin
  75.             inc(temp[i]);
  76.             break
  77.           end;
  78.   insert('.',temp,point);
  79.   if temp[1]='0' then
  80.     delete(temp,1,1);
  81.   if decimals=0 then
  82.     dec(temp[0],12)
  83.   else
  84.     dec(temp[0],11-decimals);
  85.   dec(width,length(temp));
  86.   if width>0 then begin
  87.     move(temp[1],temp[succ(width)],length(temp));
  88.     inc(temp[0],width);
  89.     fillchar(temp[1],width,' ')
  90.   end;
  91.   rounded := temp
  92. end; {rounded}
  93.  
  94.  
  95. var
  96.   q,r : real;
  97.   i : integer;
  98.  
  99.   procedure show(r : real);
  100.   var
  101.     rh,rr,rs : string;
  102.   begin
  103.     str(r:12:0,rs);
  104.     rh := HalfAdjust(r,12,0);
  105.     rr := rounded(r,12,0);
  106.     write(r,rh,rr,rs);
  107.     if rs<>rh then write(' wrong');
  108.     writeln;
  109.   end;
  110.  
  111. begin
  112.   q := 0.499999999;
  113.   r := 0.50;
  114.   writeln('    Value            HalfAdjust()    rounded()    str()');
  115.   for i := 90 to 99 do begin
  116.     show(q+i);
  117.     show(r+i);
  118.   end;
  119. end.
  120.